home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Mac Power 1997 October
/
MACPOWER-1997-10.ISO.7z
/
MACPOWER-1997-10.ISO
/
AMUG
/
PROGRAMMING
/
Mac F2C 1.3.5.sit
/
Mac F2C 1.3.5
/
Test Project ƒ
/
test.f
< prev
next >
Wrap
Text File
|
1996-06-24
|
6KB
|
219 lines
Program test_f2c
c This is a FORTRAN program to test Mac F2C v1.1
character junk*2
write(6,*) '***** Input/Output Test *****'
call i_o_test
write(6,*) '¥n***** End of I/O test, hit return to continue...'
read(5,99) junk
99 format( a1 )
write(6,*) '¥n***** Integer Math Test *****'
call int_test( 10 )
write(6,*) '¥n***** End of integer math test, hit return to continue...'
read(5,99) junk
write(6,*) '¥n***** Floating Point Math Test *****'
call flt_test( 10 )
write(6,*) '¥n***** End of floating point math test, hit return to continue...'
read(5,99) junk
write(6,*) '¥n***** Algebraic Function Test *****'
call alg_test( 10 )
write(6,*) '¥n***** End of algebraic function test, hit return to continue...'
read(5,99) junk
write(6,*) '¥n***** Transcendental Function Test *****'
call trn_test
write(6,*) '¥n***** End of transcendental function test, hit return to continue...'
read(5,99) junk
write(6,*) '¥n***** This completes all of the tests *****'
stop
end
c************************************************************************
c
c Subroutine to do the I/O tests
c
c************************************************************************
subroutine i_o_test
dimension a(5), j(5)
double precision dx
character text*40
c Screen I/O tests
write(6,*) '¥nPart 1: Screen I/O tests.¥n¥nEnter an integer value.'
read(5,*) i
write(6,*) 'The number you entered was:', i
write(6,*) '¥nEnter a single precision floating point value...'
read(5,*) x
write(6,312) x
312 format(1x, 'The number you entered was: ', f13.6)
write(6,*) '¥nEnter a double precision floating point value...'
read(5,*) dx
write(6,313) dx
313 format(1x, 'The number you entered was: ', f17.10)
write(6,*) '¥nEnter some text (40 char max)...'
read(5,*) text
write(6,*) 'The text you entered was: ', text
write(6,*) '¥nPart 2: file I/O tests. Hit return to continue...'
read(5,399) text
399 format( a1 )
c File I/O tests: Store some values and write them to file
do i = 1,5
j(i) = i
a(i) = dble(i)
enddo
text = 'A test message.'
open(60,file='test.dat',form='unformatted')
write(60) text, j, a
close(60)
write(6,*) 'Wrote the following data to file test.dat:¥n'
write(6, 304) text, (j(i), i =1,5), (a(i), i = 1,5)
304 format( 5x, a20, 5(i1, 2x), 5x, 5(f4.2, 2x) )
c Reset the variables and read them back
do i = 1,5
j(i) = 99
a(i) = 99
enddo
text = 'reset'
open(50,file='test.dat',form='unformatted')
read(50) text, j, a
close(50)
write(6, *) '¥nRead the following data from file test.dat:¥n'
write(6, 304) text, (j(i), i =1,5), (a(i), i = 1,5)
return
end
c************************************************************************
c
c Subroutine to do the integer math tests
c
c************************************************************************
subroutine int_test( m )
write( 6, *) '¥nGenerate a table of integers, squares, cubes, and their halves.¥n'
write(6, 203)
203 format( 10x, 'n', 5x, 'n^2', 5x, 'n^3', 5x, 'n/2', 3x, 'n^2/2', 3x, 'n^3/2' )
do i = 1, m
j = i**2
k = i**3
write( 6, 202 ) i, j, k, i/2, j/2, k/2
202 format( 5x, 6( i6, 2x ) )
end do
return
end
c************************************************************************
c
c Subroutine to do the floating point math tests
c
c************************************************************************
subroutine flt_test( m )
write( 6, * ) '¥nGenerate a table of floats, their squares, cubes, and their halves.¥n'
write(6, 205)
205 format( 12x, 'x', 6x, 'x^2', 6x, 'x^3', 6x, 'x/2', 4x, 'x^2/2', 4x, 'x^3/2' )
do i = 1, m
x1 = i*1.0
x2 = x1**2
x3 = x1**3
write( 6, 201 ) x1, x2, x3, x1/2, x2/2, x3/2
201 format( 5x, 6( f8.2, 1x ) )
end do
return
end
c************************************************************************
c
c Subroutine to do the algebraic function tests
c
c************************************************************************
subroutine alg_test( m )
write( 6, * ) '¥nGenerate a table of floats, square & cube roots, and their squares & cubes.¥n'
write(6, 305)
305 format( 10x, 'x', 7x, 'SQRT(x)', 4x, 'CURT(x)', 3x, 'SQRT(x)^2', 2x, 'CURT(x)^3' )
do i = 1, m
x1 = i*1.0
x2 = sqrt(x1)
x3 = x1**(1.0/3.0)
write( 6, 301 ) x1, x2, x3, x2**2, x3**3
301 format( 5x, 6( f9.6, 2x ) )
end do
return
end
c************************************************************************
c
c Subroutine to do the transcendental function tests
c
c************************************************************************
subroutine trn_test
double precision pi, x, s, c, s2, c2
character junk*2
pi = 3.141592653589793
write( 6, * ) '¥nPart 1: Trig Functions'
write( 6, *) '¥nGenerate a table of x, sin(x), cos(x) and the sum of their squares.¥n'
write(6, 207)
207 format( 9x, 'x', 9x, 'sin(x)', 8x, 'cos(x)', 4x, 'sin(x)^2 + cos(x)^2' )
do i = 0, 12
x = i * pi / 6.0
s = dsin( x )
c = dcos( x )
s2 = s**2
c2 = c**2
write( 6, 200) i, s, c, s2 + c2
200 format( 5x, i2,'*pi/6' 3x, f11.8, 3x, f11.8, 3x, f15.10 )
end do
write(6,*) '¥nPart 2: Exponential functions; hit return to continue...'
read(5,299) junk
299 format( a1 )
write(6,*) 'Generate a table of x, log(x), and exp(log(x))¥n'
write(6, 208)
208 format( 11x, 'x', 16x, 'log(x)', 9x, 'exp(log(x))' )
do i = 1, 10
x = dble(i)
s = dlog(x)
c = dexp(s)
write(6, 201) x, s, c
201 format( 5x, f13.10, 5x, f13.10, 5x, f13.10 )
end do
return
end